home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / thumna1a / thumb_pr.cls < prev    next >
Text File  |  1998-10-07  |  10KB  |  277 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "Class1"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = True
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10.  
  11.  
  12. Private Type POINTAPI
  13.         X As Long
  14.         y As Long
  15. End Type
  16.  
  17. Private Type Rect
  18.         Left As Long
  19.         Top As Long
  20.         Right As Long
  21.         Bottom As Long
  22. End Type
  23.  
  24. Public Ownerform As Form
  25.  
  26.  
  27. Private Declare Function PtInRect Lib "user32" (lpRect As Rect, ByVal ptX As Long, ByVal pty As Long) As Long
  28. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  29. Private Declare Function SetTextColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  30. Private Declare Function ExtTextOut Lib "gdi32" Alias "ExtTextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal wOptions As Long, lpRect As Rect, ByVal lpString As String, ByVal nCount As Long, lpDx As Long) As Long
  31. Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As Rect) As Long
  32. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  33.  
  34. Private Const TA_CENTER = 6
  35. Private Const ETO_OPAQUE = 2
  36. Private Const ETO_GRAYED = 1
  37. Private Const ETO_CLIPPED = 4
  38.  
  39. Private Declare Function DrawFrameControl Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal un1 As Long, ByVal un2 As Long) As Long
  40. Private Type Size
  41.         cx As Long
  42.         cy As Long
  43. End Type
  44.  
  45.  
  46.  
  47. Private Declare Function DrawCaption Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long, pcRect As Rect, ByVal un As Long) As Long
  48. Private Declare Function GetTextExtentPoint Lib "gdi32" Alias "GetTextExtentPointA" (ByVal hdc As Long, ByVal lpszString As String, ByVal cbString As Long, lpSize As Size) As Long
  49. Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal hIcon As Long) As Long
  50. Private Declare Function FrameRect Lib "user32" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
  51. Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  52. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  53. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  54. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  55. Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  56. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  57. Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long
  58. Private Declare Function Fillrect Lib "user32" Alias "FillRect" (ByVal hdc As Long, lpRect As Rect, ByVal hBrush As Long) As Long
  59. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  60.  
  61.  
  62. Rem ------- Edge
  63. Private Enum edge
  64. BDR_RAISEDOUTER = &H1
  65. BDR_SUNKENOUTER = &H2
  66. BDR_RAISEDINNER = &H4
  67. BDR_SUNKENINNER = &H8
  68. BDR_OUTER = &H3
  69. BDR_INNER = &HC
  70. BDR_RAISED = &H5
  71. BDR_SUNKEN = &HA
  72. EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
  73. EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
  74. EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
  75. EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
  76. End Enum
  77.  
  78. Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  79.  
  80. Private Const BF_LEFT = &H1
  81. Private Const BF_TOP = &H2
  82. Private Const BF_RIGHT = &H4
  83. Private Const BF_BOTTOM = &H8
  84.  
  85. Private Const BF_TOPLEFT = (BF_TOP Or BF_LEFT)
  86. Private Const BF_TOPRIGHT = (BF_TOP Or BF_RIGHT)
  87. Private Const BF_BOTTOMLEFT = (BF_BOTTOM Or BF_LEFT)
  88. Private Const BF_BOTTOMRIGHT = (BF_BOTTOM Or BF_RIGHT)
  89. Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  90.  
  91. Private Const BF_DIAGONAL = &H10
  92.  
  93. ' For diagonal lines, the BF_RECT flags specify the end point of
  94. ' the vector bounded by the rectangle parameter.
  95. Private Const BF_DIAGONAL_ENDTOPRIGHT = (BF_DIAGONAL Or BF_TOP Or BF_RIGHT)
  96. Private Const BF_DIAGONAL_ENDTOPLEFT = (BF_DIAGONAL Or BF_TOP Or BF_LEFT)
  97. Private Const BF_DIAGONAL_ENDBOTTOMLEFT = (BF_DIAGONAL Or BF_BOTTOM Or BF_LEFT)
  98. Private Const BF_DIAGONAL_ENDBOTTOMRIGHT = (BF_DIAGONAL Or BF_BOTTOM Or BF_RIGHT)
  99.  
  100. Private Const BF_MIDDLE = &H800    ' Fill in the middle.
  101. Private Const BF_SOFT = &H1000     ' Use for softer buttons.
  102. Private Const BF_ADJUST = &H2000   ' Calculate the space left over.
  103. Private Const BF_FLAT = &H4000     ' For flat rather than 3-D borders.
  104. Private Const BF_MONO = &H8000     ' For monochrome borders.
  105. Rem --edge
  106. Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As Rect, ByVal edge As Long, ByVal grfFlags As Long) As Boolean
  107. Private Declare Function OleTranslateColor Lib "OLEPRO32.DLL" (ByVal OLE_COLOR As Long, ByVal HPALETTE As Long, pccolorref As Long) As Long
  108. Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
  109. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  110.  
  111. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  112. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  113.  
  114. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  115.  
  116.  
  117.  
  118.  
  119. 'Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
  120.  
  121. Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
  122.  
  123.  
  124.  
  125. Private Const SRCAND = &H8800C6
  126.  
  127. Private Const SRCCOPY = &HCC0020
  128.  
  129. Private Const SRCERASE = &H440328
  130.  
  131. Private Const SRCINVERT = &H660046
  132.  
  133. Private Const SRCPAINT = &HEE0086
  134.  
  135. Public Enum Scroll_Direction
  136. Vertical = 1
  137. Horizontal = 0
  138. End Enum
  139.  
  140. Public Enum Lense_Shape
  141. Custom_ = 1
  142. Circle_ = 2
  143. Wide_Screen = 3         'this will Change your Height setting slightly
  144. End Enum
  145.  
  146.  
  147. Public Pos_Top As Long
  148. Public Pos_Left As Long
  149. Public Pos_Width As Long
  150. Public Pos_Height As Long
  151. Public Scrolling As Scroll_Direction
  152.  
  153. Public Thum_Height As Long
  154. Public Thum_Width As Long
  155. Public AutoRepeat As Boolean
  156. Public ThumCount As Long
  157. Public Lens_Shape As Lense_Shape
  158.  
  159. Public ProjectTo As Long
  160. Public ProjectOn As Boolean
  161. Private ThumbPics() As String
  162. Private Loaded_Count As Long
  163. Private LoadedPics() As StdPicture
  164.  
  165. Private Stop_Film As Boolean
  166. Function Pic_ADD(Filename As String)
  167. Loaded_Count = Loaded_Count + 1
  168. ReDim Preserve ThumbPics(Loaded_Count)
  169. ThumbPics(Loaded_Count) = Filename
  170. End Function
  171. Function Pic_DEL(Position As Long)
  172.  
  173. Dim tmp() As String
  174. For X = 1 To LoadedCount
  175. If X = Position Then GoTo Bp:
  176. NI = NI + 1
  177. tmp(NI) = ThumbPics(X)
  178. Bp:
  179. Next X
  180.  
  181. ReDim ThumbPics(NI)
  182.  
  183. For X = 1 To NI
  184. ThumbPics(X) = tmp(NI)
  185. Next X
  186. Loaded_Count = NI
  187. Erase tmp
  188. End Function
  189.  
  190. Function Roll_Tape(Optional StartThumb As Long, Optional EndThumb As Long)
  191. If Stop_Film = True Then Form1.Cls
  192.  
  193. Dim Current_Cell As Rect
  194. Dim tmp As Long
  195. Dim X As Long
  196. Dim Curpos As Long
  197.  
  198. 'Current_Cell.Left = Me.Pos_Left
  199. 'Current_Cell.Right = Me.Pos_Width
  200. 'Current_Cell.Bottom = Me.Pos_Height
  201. 'Current_Cell.Top = Me.Pos_Top
  202. If starthumb = 0 Then StartThumb = 1
  203. If EndThumb = 0 Then EndThumb = Me.ThumCount
  204. For tmp = 1 To Loaded_Count
  205. memdc = CreateCompatibleDC(Ownerform.hdc)
  206. Oldhdc = SelectObject(memdc, LoadedPics(tmp).Handle)
  207.  
  208. Curpos = 1
  209.  
  210. For X = StartThumb To EndThumb
  211.  
  212. ret = StretchBlt(Ownerform.hdc, Me.Pos_Left, Me.Pos_Top, Me.Pos_Width, Pos_Height, memdc, 1, Curpos, Me.Thum_Width, Me.Thum_Height, SRCCOPY)
  213.  
  214. If Me.ProjectTo = 0 The